## Created by EmpowerStats @ Wed, 15 Jan 25 14:27:33 +0800## 
#******************** Regarding ALL Following R Code   ******************** 
#*** COPYRIGHT (c) 2010, 2021 X&Y Solutions, ALL RIGHT RESERVED *********** 
#******************* www.EmpowerStats.com ********************************* 
#************************************************************************** 
Sys.setlocale(category = 'LC_ALL', locale = 'English_United States.1252'); 
.libPaths(file.path(R.home(),'library')); 
library(doBy); 
options(timeout=600); 
library(plotrix); 
library(stringi); 
library(stringr); 
library(survival); 
library(rms); 
library(nnet); 
library(car); 
library(mgcv); 
pdfwd<-6; pdfht<-6; 
load('/Users/liukangning/Desktop/EmpowerROS/Analysis/cognitivedepression/datamergeall.Rdata'); 
if (length(which(ls()=='EmpowerStatsR'))==0) EmpowerStatsR<-get(ls()[1]); 
names(EmpowerStatsR)<-toupper(names(EmpowerStatsR)); 
originalVNAME<-names(EmpowerStatsR); 
ofname<-'cognitivedepression_0_data'; 
attach(EmpowerStatsR); 
sink(paste(ofname,'.lst',sep='')); 
print('Creating new variable: PIR.CATG'); 
PIR.CATG<- PIR; 
summary(PIR.CATG); 
EmpowerStatsR<-cbind(EmpowerStatsR,PIR.CATG); 
print('Creating new variable: PIR.CATG1'); 
PIR.CATG1<- PIR; 
summary(PIR.CATG1); 
EmpowerStatsR<-cbind(EmpowerStatsR,PIR.CATG1); 
print('Creating new variable: PIR.CATG2'); 
PIR.CATG2<- PIR; 
summary(PIR.CATG2); 
EmpowerStatsR<-cbind(EmpowerStatsR,PIR.CATG2); 
print('Creating new variable: PIR.CATG3'); 
PIR.CATG3<- PIR; 
summary(PIR.CATG3); 
EmpowerStatsR<-cbind(EmpowerStatsR,PIR.CATG3); 
rm(PIR.CATG,PIR.CATG1,PIR.CATG2,PIR.CATG3); 
sink(); 
chr_matrix2nchar<-function(mx,l, append) {
 ch="                                                                                                       "
 mx[is.na(mx)]<-"NA"
 g0=stri_length(as.character(mx)) 
 if (l>max(g0,na.rm=TRUE)) {
   g1=stri_sub(rep(ch,length(g0)),1,l-g0)
   if (append==T) {oo<-paste(mx,g1,sep="")} else {oo<-paste(g1,mx,sep="")}
   } else {oo<-stri_sub(mx,1,l)}
 return(oo)
}
lstvar <- function(mx) {
  ss<-stri_sub(mx, from = 1L, length=40)
  nmiss <- sum(is.na(mx))
  ntotal<- length(mx)
  ss<-unique(ss)
  ss1<-ss[order(ss)]
  nunique<-length(ss1)
  oo<-rbind(ss1[1],ss1[2],ss1[3],"......",ss1[round(nunique/2,0)],"......",ss1[nunique-2],ss1[nunique-1],ss1[nunique],"------")
  oo<-rbind(oo,paste("Total:",ntotal, "  unique:", nunique, "  Missing:", nmiss))
  oo<-matrix(paste("       ",oo),ncol=1)
  return(oo)
}
frqvar<-function(mx) {
 mxwidth<-max(stri_length(mx),na.rm=TRUE)
 if (mxwidth<=12 | is.numeric(mx)) {
   oo1 <- "         value        count -------- percent -------------------------"
   ss<-as.matrix(table(mx,useNA="ifany"))
   s1<-substr(as.character(rownames(ss)),0,9)
   s2<-as.character(ss)
   p<-round(ss/sum(ss,na.rm=TRUE)*100,2)
   nstr<-round(p/3,0)
   star<-rep("****************************************************",times=nrow(nstr))
   s3<-stri_sub(star,1,nstr)
   oo2<-paste("         ",chr_matrix2nchar(s1,12,append=T),chr_matrix2nchar(s2,6,append=F),"|",s3,p,"%",sep="")
   oo3<-paste("             Total   ",chr_matrix2nchar(sum(ss,na.rm=TRUE),6,append=F),sep="")
   oo=rbind(oo1,as.matrix(oo2,ncol=1),oo3)
 } else {
   if (mxwidth>65) {mxwidth<-65};
   tt="                                                                 "
   oo1 <- paste("    value",stri_sub(tt,1,mxwidth),"   count",sep="")
   ss<-as.matrix(table(mx,useNA="ifany"))
   s1<-stri_sub(as.character(rownames(ss)),1,mxwidth)
   s1<-ifelse(stri_length(s1)>=65,paste(s1,"...",sep=""),s1)
   s2<-as.character(ss)
   p<-round(ss/sum(ss,na.rm=TRUE)*100,2)
   oo2<-paste("    ",chr_matrix2nchar(s1,mxwidth+5,append=T),chr_matrix2nchar(s2,8,append=F),"|",p,"%",sep="")
   oo3<-paste("    Total",chr_matrix2nchar(sum(ss,na.rm=TRUE),mxwidth+8,append=F),sep="")
   oo=rbind(oo1,as.matrix(oo2,ncol=1),oo3)
 } 
 return(oo)
} 
univar<-function(mx) {
 n<-sum(!is.na(mx))
 xx0<-c(' min','  5%',' 10%',' 25%',' 50%',' 75%',' 90%',' 95%',' max','mean',' std','   n');
 xx1<-quantile(mx, probs=c(0,0.05,0.10,0.25,0.50,0.75,0.90,0.95,1), na.rm=TRUE)
 xx1<-append(xx1,mean(mx,na.rm=TRUE),after=length(xx1))
 xx1<-append(xx1,sd(mx,na.rm=TRUE),after=length(xx1))
 xx1<-round(xx1,3)
 xx1<-append(xx1,n,after=length(xx1))
 xx1<-chr_matrix2nchar(as.matrix(xx1),15,append=F)
 d<-(max(mx[mx!=Inf],na.rm=TRUE)-min(mx[mx!=-Inf],na.rm=TRUE))/10
 xx2<-seq(min(mx[mx!=-Inf],na.rm=TRUE),max(mx[mx!=Inf],na.rm=TRUE),d)
 dtn<-rep(0,10)
 for (i in (1:10)) dtn[i]<-sum(mx>xx2[i],na.rm=TRUE)
 dtn<-dtn-append(dtn[-1],0)
 dtn<-append(1,dtn,after=1)
 dtn<-append(dtn,1,after=length(dtn))
 xx2<-append(min(mx[mx!=-Inf],na.rm=TRUE),xx2[-1]-d/2,after=1)
 xx2<-append(xx2,max(mx[mx!=Inf],na.rm=TRUE),after=length(xx2))
 xx2<-round(xx2,3)
 xx2<-chr_matrix2nchar(as.matrix(xx2),15,append=F)
 dtn=round(dtn*40/n,0)
 star<-"*******************************************************"
 xx3<-stri_sub(rep(star,length(dtn)),1,dtn)
 oo<-"   percentile                         |--------distribution--------------"
 oo<-rbind(oo,as.matrix(paste("   ",xx0,xx1,xx2," |",xx3,sep=""),ncol=1))
 o1<-paste("      .",chr_matrix2nchar(sum(is.na(mx)),15,append=F),"                |--------distribution--------------",sep="")
 oo<-rbind(oo,o1)
 return(oo)
}
DATADST <- function(EmpowerStatsR, outfile, datatxt, pathtxt, vlabel) {
 nvar<-ncol(EmpowerStatsR)
 nobs<-nrow(EmpowerStatsR)
 vname<-names(EmpowerStatsR)
 vtype<-rep("n",nvar)
 vlength<-rep(1,nvar)
 if (length(vlabel)!=nvar) vlabel=rep(" ",nvar)
 xx="OUTPUT of datadst() Programed by EmpowerStats (www.empowerstats.com)"
 xx=rbind(xx, paste("Data file name        :", datatxt))
 xx=rbind(xx, paste("Data location         :", pathtxt))
 xx=rbind(xx, paste("Number of observations:", nobs))
 xx=rbind(xx, paste("Number of variables   :", nvar)) 
 xx=rbind(xx, "Variables List:")
 for (i in (1:nvar)) {
  if (!is.numeric(EmpowerStatsR[,i])) vtype[i]="$"
  vlength[i]=max(stri_length(as.character(EmpowerStatsR[,i])),na.rm=TRUE)
 }
 varnchar<-max(max(stri_length(vname),na.rm=TRUE)+2, 15)
 vtypelg<-paste(vtype,vlength,sep="")
 vtlnchr<-max(max(stri_length(vtypelg),na.rm=TRUE)+2,5)
 vartxt<-paste(" ",chr_matrix2nchar(vname,varnchar,append=T),chr_matrix2nchar(vtypelg,vtlnchr,append=T),vlabel, sep="")
 xx=rbind(xx,as.matrix(vartxt))
 xx=rbind(xx,"Variables Distribution:")
 for (i in (1:nvar)) {
  mx<-as.matrix(EmpowerStatsR[,i],ncol=1)
  viuni <- length(unique(EmpowerStatsR[,i]))
  vitype<- is.numeric(EmpowerStatsR[,i])
  xx=rbind(xx,"    ",vname[i])
  if (vitype) {
   if (viuni>20) xx=rbind(xx, univar(mx))
   else xx=rbind(xx,frqvar(mx)) 
  } else {
   if (viuni>100) xx=rbind(xx, lstvar(mx))
   else xx=rbind(xx,frqvar(mx)) 
  }
 }
 xx=rbind(xx, "    ")
 xx=rbind(xx, "******************** THE END ************************")
 write.table(xx,file=outfile,quote=FALSE,col.names=FALSE,row.names=FALSE)
}
DFMDST <- function(DFM, ofile, vtype=c()) {
  nvar<-ncol(DFM); vname<-names(DFM); 
  if (length(vtype)==0) vtype=rep(NA,nvar)
  for (i in (1:nvar)) {
    mx<-as.matrix(DFM[,i],ncol=1)
    viuni <- length(unique(DFM[,i]))
    vitype<- is.numeric(DFM[,i])
    xx=rbind("    ",vname[i])
    if (vitype) {
      if (is.na(vtype[i])) {
        if (viuni>20) {xx=rbind(xx, univar(mx));} else {xx=rbind(xx,frqvar(mx));}
      } else {
        if (vtype[i]==0) {xx=rbind(xx, univar(mx));} else {xx=rbind(xx,frqvar(mx));}
      }  
    } else {
      if (viuni>100) {xx=rbind(xx, lstvar(mx));} else {xx=rbind(xx,frqvar(mx));}
    }
    write.table(xx,file=ofile,quote=FALSE,col.names=FALSE,row.names=FALSE,append=TRUE)
  }
} 
nvdst.fname<-paste(ofname,'.dst',sep=''); 
write.table('', file=nvdst.fname,quote=FALSE,col.names=FALSE,row.names=FALSE,append=FALSE); 
tmpname <- c('SEQN','EDUCATION','MARITAL','PIR','GENDER','AGE','RACE','BMI','BP','CORONARY','STROKE','DPQ010','DPQ020','DPQ030','DPQ040','DPQ050','DPQ060','DPQ070','DPQ080','DPQ090','DPQ','DPQF','AFT','CERAD4','CERAD1','CERAD2','CERAD3','CERAD','DSST','PIR.CATG','PIR.CATG1','PIR.CATG2','PIR.CATG3'); 
DFM <-data.frame(EmpowerStatsR[,tmpname]); 
names(DFM) <- tmpname; 
DFMDST(DFM, nvdst.fname, vtype=c(0,5,6,0,2,0,6,0,2,2,2,5,6,4,4,5,5,5,4,5,0,2,0,11,11,11,11,0,0,21,21,21,21));